home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclLoadNext.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  3.2 KB  |  112 lines  |  [TEXT/CWIE]

  1. /* 
  2.  * tclLoadNext.c --
  3.  *
  4.  *    This procedure provides a version of the TclLoadFile that
  5.  *    works with NeXTs rld_* dynamic loading.  This file provided
  6.  *    by Pedja Bogdanovich.
  7.  *
  8.  * Copyright (c) 1995 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tclLoadNext.c 1.4 96/02/15 11:58:55
  14.  */
  15.  
  16. #include "tclInt.h"
  17. #include <mach-o/rld.h>
  18. #include <streams/streams.h>
  19.  
  20. /*
  21.  *----------------------------------------------------------------------
  22.  *
  23.  * TclLoadFile --
  24.  *
  25.  *    Dynamically loads a binary code file into memory and returns
  26.  *    the addresses of two procedures within that file, if they
  27.  *    are defined.
  28.  *
  29.  * Results:
  30.  *    A standard Tcl completion code.  If an error occurs, an error
  31.  *    message is left in interp->result.  *proc1Ptr and *proc2Ptr
  32.  *    are filled in with the addresses of the symbols given by
  33.  *    *sym1 and *sym2, or NULL if those symbols can't be found.
  34.  *
  35.  * Side effects:
  36.  *    New code suddenly appears in memory.
  37.  *
  38.  *----------------------------------------------------------------------
  39.  */
  40.  
  41. int
  42. TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
  43.     Tcl_Interp *interp;        /* Used for error reporting. */
  44.     char *fileName;        /* Name of the file containing the desired
  45.                  * code. */
  46.     char *sym1, *sym2;        /* Names of two procedures to look up in
  47.                  * the file's symbol table. */
  48.     Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
  49.                 /* Where to return the addresses corresponding
  50.                  * to sym1 and sym2. */
  51. {
  52.   struct mach_header *header;
  53.   char *data;
  54.   int len, maxlen;
  55.   char *files[]={fileName,NULL};
  56.   NXStream *errorStream=NXOpenMemory(0,0,NX_READWRITE);
  57.  
  58.   if(!rld_load(errorStream,&header,files,NULL)) {
  59.     NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
  60.     Tcl_AppendResult(interp,"couldn't load file \"",fileName,"\": ",data,NULL);
  61.     NXCloseMemory(errorStream,NX_FREEBUFFER);
  62.     return TCL_ERROR;
  63.   }
  64.   NXCloseMemory(errorStream,NX_FREEBUFFER);
  65.  
  66.   *proc1Ptr=NULL;
  67.   if(sym1) {
  68.     char sym[strlen(sym1)+2];
  69.     sym[0]='_'; sym[1]=0; strcat(sym,sym1);
  70.     rld_lookup(NULL,sym,(unsigned long *)proc1Ptr);
  71.   }
  72.  
  73.   *proc2Ptr=NULL;
  74.   if(sym2) {
  75.     char sym[strlen(sym2)+2];
  76.     sym[0]='_'; sym[1]=0; strcat(sym,sym2);
  77.     rld_lookup(NULL,sym,(unsigned long *)proc2Ptr);
  78.   }
  79.  
  80.   return TCL_OK;
  81. }
  82.  
  83. /*
  84.  *----------------------------------------------------------------------
  85.  *
  86.  * TclGuessPackageName --
  87.  *
  88.  *    If the "load" command is invoked without providing a package
  89.  *    name, this procedure is invoked to try to figure it out.
  90.  *
  91.  * Results:
  92.  *    Always returns 0 to indicate that we couldn't figure out a
  93.  *    package name;  generic code will then try to guess the package
  94.  *    from the file name.  A return value of 1 would have meant that
  95.  *    we figured out the package name and put it in bufPtr.
  96.  *
  97.  * Side effects:
  98.  *    None.
  99.  *
  100.  *----------------------------------------------------------------------
  101.  */
  102.  
  103. int
  104. TclGuessPackageName(fileName, bufPtr)
  105.     char *fileName;        /* Name of file containing package (already
  106.                  * translated to local form if needed). */
  107.     Tcl_DString *bufPtr;    /* Initialized empty dstring.  Append
  108.                  * package name to this if possible. */
  109. {
  110.     return 0;
  111. }
  112.